home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / JARexx / RexxView.f < prev    next >
Encoding:
FORTH Source  |  1991-12-17  |  4.7 KB  |  243 lines
  1. \ RexxView by Martin Kees
  2. \ JForth REXX peeker
  3. \ CLI utility to monitor REXX message traffic
  4. \ Usage: rexxview outfile
  5. \ Terminate by sending: closerexxview to REXX port
  6. \ i.e. from CLI: rx CLOSEREXXVIEW
  7. \ 3/JUN/91
  8. \ Freely Distributable
  9. \
  10. \ MOD: PLB 7/21/91 00001 Added print of CommAddr:
  11. \            Added include? for VALUE, c/TASK_REXXVIEW/TASK-REXXVIEW/
  12. \ MOD: MCK 12/8/91 00002 fixed rm_CommAdr call c/../s@/
  13. \ MOD: MCK 12/8/91 00003 check for NULL 0string in ?0type
  14. \ MOD: MCK 12/8/91 00004  added abort if REXX port vanishes
  15. \ MOD: MCK 12/8/91 00005  c /quit/exit/
  16.  
  17. getmodule includes
  18. getmodule arexxmod    \ ji:arexx/storage.j ji:arexx/rxslib.j
  19. include? value ju:value
  20. include? addport()   ju:exec_support
  21. \ include? rexxsyslib? jrx:ArexxCalls.f
  22.  
  23. anew task-rexxview
  24.  
  25. 0 value rxpri
  26. 0 value myport
  27. 0 value rxport
  28. 0 value rmsg
  29. 0 value ofile
  30.  
  31. .NEED RXFF_NOIO
  32. 1   RXFB_NOIO   <<  constant RXFF_NOIO
  33. .THEN
  34.  
  35. .NEED forbid()
  36. : FORBID() ( -- )
  37.     callvoid exec_lib forbid
  38. ;
  39. .THEN
  40.  
  41. .NEED permit()
  42. : PERMIT() ( -- )
  43.     callvoid exec_lib permit 
  44. ;
  45. .THEN
  46.  
  47. : dscanlist ( port -- rexxport true | 0 )
  48.   begin
  49.     s@ ln_succ dup
  50.     IF dup s@ ln_name ?dup
  51.       IF
  52.        RXSDIR 4 compare
  53.        IF-NOT true exit
  54.        THEN
  55.       THEN 
  56.     THEN
  57.     dup
  58.   until-not  
  59. ;
  60.  
  61. \ Not needed after I found that the message port list
  62. \ is priority sorted but ...
  63. : uscanlist ( port -- rexxport true | 0 )
  64.   begin
  65.     s@ ln_pred dup
  66.     IF dup s@ ln_name ?dup
  67.       IF
  68.        RXSDIR 4 compare
  69.        IF-NOT true exit
  70.        THEN
  71.       THEN
  72.     THEN
  73.     dup
  74.   until-not
  75. ;
  76.  
  77. : Openmyport ( -- flag )
  78.   0 -> myport
  79.   forbid()
  80.   RXSDIR findport() dup -> rxport
  81.   IF  rxport ..@ ln_pri -> rxpri
  82.       RXSDIR rxpri 1+ Createport() -> myport
  83.   THEN
  84.   permit()
  85.   myport
  86. ;
  87.  
  88. : Closemyport ( -- )
  89.   myport   ?dup IF deleteport()
  90.                    0 -> myport
  91.                 THEN
  92. ;
  93.  
  94. : msg>taskname ( msg -- 0$task )
  95.   s@ mn_replyport
  96.   s@ mp_SigTask
  97.   s@ ln_name
  98. ;
  99.  
  100. : msg>arg0 ( msg -- 0str )
  101.   .. rm_args @ >rel 
  102. ;
  103.  
  104. : fcr
  105.   10 pad c! ofile pad 1 fwrite drop
  106. ;
  107.  
  108.  
  109. : >ofile ( srt -- )
  110.   ofile swap count fwrite drop
  111. ;
  112.  
  113. : ?0type ( 0str str -- )
  114.   ofile swap count fwrite drop
  115.   ?dup                         \ MCK 00003
  116.   IF-NOT " Null" >ofile        \     00003
  117.   ELSE  0count
  118.   ?dup IF ofile -rot fwrite drop
  119.        ELSE drop " Null" >ofile
  120.        THEN
  121.   THEN
  122.   fcr
  123. ;
  124.  
  125. : term.rv ( msg -- )
  126.    replymsg()
  127.    begin myport getmsg() ?dup
  128.    while replymsg()
  129.    repeat
  130.    closemyport
  131.    ofile fclose
  132. ;
  133.  
  134. : SendToRexx ( msg -- flag )
  135.   forbid()
  136.   myport dscanlist
  137.   ?dup IF-NOT  myport uscanlist
  138.        THEN
  139.   IF swap putmsg()   true
  140.   ELSE   false
  141.   THEN
  142.   permit()
  143.   IF-NOT
  144.      " REXX port closed!" >ofile
  145.      term.rv abort                  \ MCK 00004
  146.   THEN
  147. ;
  148.  
  149. : aboutmsg
  150.   ofile " RexxView by Martin Kees " count fwrite drop fcr
  151.   ofile " (c) 1991 M C Kees"        count fwrite drop fcr
  152.   ofile " Freely Distributable"     count fwrite drop fcr
  153. ;
  154.  
  155.  
  156. : .action ( msg -- )
  157.   " Action: " swap
  158.   ..@ rm_action  RXCODEMASK AND
  159. CASE
  160. RXCOMM   OF   0" RXCOMM"
  161.          ENDOF
  162. RXFUNC   OF   0" RXFUNC"
  163.          ENDOF
  164. RXCLOSE  OF   0" RXCLOSE"
  165.          ENDOF
  166. RXQUERY  OF   0" RXQUERY"
  167.          ENDOF
  168. RXADDFH  OF   0" RXADDFH"
  169.          ENDOF
  170. RXADDLIB OF   0" RXADDLIB"
  171.          ENDOF
  172. RXREMLIB OF   0" RXREMLIB"
  173.          ENDOF
  174. RXADDCON OF   0" RXADDCON"
  175.          ENDOF
  176. RXREMCON OF   0" RXREMCON"
  177.          ENDOF
  178. RXTCOPN  OF   0" RXTCOPN"
  179.          ENDOF
  180. RXTCCLS  OF   0" RXTCCLS"
  181.          ENDOF
  182.          0" UNKNOWN" swap
  183. ENDCASE
  184.     swap ?0type
  185. ;
  186.  
  187. : .modifier ( msg -- )
  188.   " Modifier: " >ofile
  189.   ..@ rm_action
  190.   dup RXFF_RESULT  and IF " RXFB_RESULT " >ofile
  191.                        THEN
  192.   dup RXFF_STRING  and IF " RXFB_STRING " >ofile
  193.                        THEN
  194.   dup RXFF_TOKEN   and IF " RXFB_TOKEN  " >ofile
  195.                        THEN
  196.   dup RXFF_NONRET  and IF " RXFB_NONRET " >ofile
  197.                        THEN
  198.   dup RXFF_NOIO    and IF " RXFB_NOIO   " >ofile
  199.                        THEN
  200.   drop fcr
  201. ;
  202.  
  203.  
  204.  
  205. : rexxview ( -- )
  206.   new fileword
  207.   dup 1+ c@ ascii ? = over c@ 0= OR
  208.   IF drop cr
  209.      ." Usage: rexxview  OutputFileName" cr
  210.      ." Terminate by sending to REXX: closerexxview"  cr
  211.      exit
  212.   THEN
  213.   $fopen -> ofile
  214.   ofile
  215.  IF
  216.   openmyport
  217.   IF aboutmsg
  218.     BEGIN
  219.      myport waitport() drop
  220.      myport getmsg() -> rmsg
  221.      rmsg msg>taskname " From Task: " ?0type
  222.      rmsg .action
  223.      rmsg .modifier
  224.      rmsg s@ rm_CommAddr " CommAddr: " ?0type  \ PLB 00001 MCK 00002
  225.      rmsg msg>arg0
  226.       dup " Arg0: " ?0type fcr
  227.        0" closerexxview" 0count compare
  228.        IF-NOT rmsg term.rv
  229.               exit                   \ MCK 00005
  230.        THEN
  231.      rmsg sendtorexx
  232.     AGAIN
  233.   ELSE ofile fclose
  234.        rxport IF-NOT ." REXX not found " cr exit
  235.               THEN
  236.   THEN
  237.   myport IF-NOT ." No memory for RexxView port!" cr exit
  238.          THEN
  239.  ELSE
  240.   ." Couldn't open output file" cr
  241.  THEN
  242. ;
  243.